The X-Philes (2nd Revision)

home *** CD-ROM | disk | FTP | other *** search

/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48hor2 / chess.src < prev next >

Wrap

Text File | 1992-01-11 | 14KB | 483 lines

%%HP: T(3)A(D)F(.); @ CHESS by Paul Dale DIR play \<< RCLF 'FLGS' STO STBRD OBJ\-> 'BRD' STO "2'DPTH'0'PLY'0'MTBL'0'EPSNT'0'SCORE'25'PKNG'95'CKNG'1 7" OBJ\-> START STO NEXT { # 400306410103F4h # 0h } STOF # 83h # 40h BLANK PICT STO { # 0h # 0h } PVIEW DRWB DO "____" 'INP' STO 2 SF FINP MOVE MEM DROP UNTIL 1 FS? END FLGS STOF "{FLGS DPTH PLY BRD INP MTBL SCORE PKNG CKNG EPSNT}" OBJ\-> PURGE \>> DISPMV \<< C\->R \-> frs tos \<< PICT frs COORDS C\->R SWAP R\->C 8 * (7,7) - # 8h # 8h BLANK IF frs DUP 10 / IP + 2 MOD THEN NEG END REPL tos BDGT DUP ABS SWAP SIGN \-> p col \<< PICT tos COORDS C\->R SWAP R\->C 8 * (7,7) - DUP2 # 8h # 8h BLANK IF tos DUP 10 / IP + 2 MOD THEN NEG END REPL IF tos DUP 10 / IP + 2 MOD DUP col -1 SAME XOR THEN 2 ELSE 1 END FIG SWAP GET p GET SWAP \<< GXOR \>> \<< GOR \>> IFTE \>> \>> DROP \>> FIG { { GROB 8 8 0000C3424242C300 GROB 8 8 00C366242764C700 GROB 8 8 00C143426624E700 GROB 8 8 00E7A5242424E700 GROB 8 8 00E7A5662424E700 GROB 8 8 00C366246624E700 } { GROB 8 8 0000008181810000 GROB 8 8 000081C3C0830000 GROB 8 8 0000808181C30000 GROB 8 8 000042C3C3C30000 GROB 8 8 00004281C3C30000 GROB 8 8 000081C381C30000 } } debugs \<< \-> n \<< DUP C\->R UNCVT SWAP UNCVT SWAP + PLY \->STR " " + n \->STR + " " + SWAP + " " + 5 DIS \>> \>> SORTMV \<< \-> xt sq \<< { } 1 22 START DUP NEXT 21 \->LIST DUP \-> xht sht \<< 1 xt SIZE FOR n xht xt n GET DUP C\->R DROP IF DUP 18 > THEN DROP 18 END 1 + DUP xht SWAP GET ROT + OVER sht SWAP DUP2 GET sq n GET + PUT 'sht' STO PUT 'xht' STO NEXT 'xt' STO 'sq' STO "6 16 9 13 8 14 7 15 2 20 3 1 1 12" STR\-> START xt xht 3 PICK GET + 'xt' STO sq sht ROT GET + 'sq' STO NEXT xt sq \>> \>> \>> SEARCH \<< MEM DROP 1 'PLY' STO+ \-> l1 col \<< MAXR col * { i i } \-> l2 best \<< col ALLMV SORTMV DUP SIZE IF col 0 > THEN \<< \>= \>> \<< < \>> ELSE \<< \<= \>> \<< > \>> END \-> xt sq n c1 c2 \<< DO xt n GET sq n GET DUP2 MKMV n debugs DUP C\->R SWAP DROP DUP MVGEN DROP SIZE 200 / SWAP COORDS DUP (4.5,4.5) - ABS 10 * INV RD2 SWAP col 0 > CKNG PKNG IFTE COORDS - ABS 10 * 1 + INV RD2 + + col * DUP NEG SCUPD ROT ROT 12 col * col SCOREMV IF 1 THEN DUP \->STR " " + 6 DIS END IF DUP l1 c1 EVAL THEN 8 CF IF DUP l2 c2 EVAL THEN 'l2' STO DUP2 IF PLY 1 SAME THEN DUP2 SHOWMV END 2 \->LIST 'best' STO ELSE DROP END ELSE 'l2' STO 8 SF END n 1 - DUP 'n' STO IF NOT THEN 8 SF END UNMKMV SCUPD UNTIL 8 FS? END \>> best LIST\-> DROP l2 \>> \>> 'PLY' 1 STO- \>> SCOREMV \<< IF PLY DPTH == THEN DROP2 SCORE ELSE NEG SEARCH ROT ROT DROP2 END \>> GETMV \<< \-> n \<< n GET SWAP n GET SWAP \>> \>> CPMV \<< MAXR -1 IF 5 FS? THEN NEG SWAP NEG SWAP END SEARCH DROP "My move" 3 DIS DUP2 SHOWMV DUP2 MKMV DISPMV ERRBELL \>> UNMKMV \<< \-> xt sq \<< sq C\->R xt C\->R \-> frs tos t z \<< 'BRD' DUP tos BDGT DUP SIGN \-> col \<< frs SWAP PUT tos 0 PUT IF tos PKNG SAME THEN frs 'PKNG' STO ELSE IF tos CKNG SAME THEN frs 'CKNG' STO END END IF xt i \=/ THEN IF t 1 SAME THEN z GTML NEG MTUPD 'BRD' tos z PUT ELSE IF t 2 SAME THEN z 'EPSNT' STO ELSE IF t NOT THEN 'BRD' tos 10 col * - col NEG PUT col GTML MTUPD ELSE IF t 20 > THEN 'BRD' DUP t z BDGT PUT z 0 PUT ELSE 'BRD' DUP frs col PUT tos t 10 - DUP GTML z GTML - col GTML - MTUPD PUT END END END END END \>> \>> \>> \>> GTML \<< DUP SIGN SWAP ABS \-> col pce \<< [ 1 3.25 3.5 5 9 120 ] pce IFERR GET THEN DROP2 0 ELSE col * END \>> \>> SCUPD \<< 'SCORE' STO+ \>> MTUPD \<< DUP 'MTBL' STO+ SCUPD \>> MKMV \<< \-> xt sq \<< sq C\->R xt C\->R \-> frs tos t z \<< IF frs PKNG SAME THEN tos 'PKNG' STO ELSE IF frs CKNG SAME THEN tos 'CKNG' STO END END 'BRD' DUP frs BDGT DUP DUP SIGN SWAP ABS \-> col ptyp \<< tos SWAP PUT frs 0 DUP 'EPSNT' STO PUT IF xt i \=/ THEN IF t 1 SAME THEN z GTML MTUPD ELSE IF t 2 SAME THEN frs 10 col * + 'EPSNT' STO ELSE IF t NOT THEN 'BRD' tos 10 col * - 0 PUT col NEG GTML MTUPD ELSE IF t 20 > THEN 'BRD' DUP z t BDGT PUT t 0 PUT ELSE z GTML MTUPD 'BRD' tos t 10 - DUP GTML col GTML SWAP - MTUPD PUT END END END END END \>> \>> \>> \>> CVRTSQ \<< DUP 1 DUP SUB "abcdefgh" SWAP POS SWAP 2 DUP SUB "12345678" SWAP POS \-> x y \<< IF x NOT y NOT OR THEN 4 SF ELSE x 10 DUP y * + + END \>> \>> PLMV \<< 4 CF INP CVRTSQ INP 3 4 SUB CVRTSQ \-> frs tos \<< IF 4 FC? frs BDGT DUP 0 > SWAP 7 \=/ AND AND THEN frs MVGEN frs tos R\->C POS DUP IF 0 SAME THEN DROP ELSE GET frs tos R\->C DUP2 MKMV DISPMV 6 SF END END \>> \>> ALLMV \<< { } DUP \-> col sq xt \<< 21 98 FOR n IF n BDGT DUP SIGN col SAME SWAP 7 \=/ AND THEN n MVGEN sq + 'sq' STO xt + 'xt' STO END NEXT xt sq \>> \>> MVGEN \<< 3 CF { } DUP \-> p sq xt \<< p BDGT DUP SIGN SWAP ABS \<< xt + 'xt' STO p SWAP R\->C sq + 'sq' STO \>> \-> col pce admov \<< \<< p + DUP BDGT DUP DUP DUP IF THEN 3 SF END IF 7 \=/ SWAP SIGN col \=/ AND THEN IF DUP NOT THEN DROP i ELSE 1 SWAP R\->C END admov EVAL ELSE DROP2 END \>> \-> chk \<< \<< STR\-> START 0 DO OVER + DUP chk EVAL UNTIL 3 FS?C END DROP2 NEXT \>> \-> mmv \<< { \<< \<< \-> tos \<< IF tos 10 / IP DUP 2 SAME SWAP 9 SAME OR THEN 2 5 FOR m tos DUP BDGT m col * 10 + SWAP R\->C admov EVAL NEXT 0 ELSE tos 1 END \>> \>> \-> promote \<< \<< DUP IF DUP EPSNT SAME THEN i NEG admov EVAL DROP ELSE IF BDGT DUP DUP 7 \=/ SWAP SIGN col + NOT AND THEN SWAP IF promote EVAL THEN 1 ROT R\->C admov EVAL ELSE DROP END ELSE DROP2 END END \>> \-> capchk \<< 10 col * p + DUP DUP IF BDGT THEN DROP ELSE IF promote EVAL THEN i admov EVAL ELSE DROP END IF p 10 / IP DUP 3 SAME SWAP 8 SAME OR THEN 20 col * p + DUP IF BDGT THEN DROP ELSE 2 EPSNT R\->C admov EVAL END END END 1 DUP2 + capchk EVAL - capchk EVAL \>> \>> \>> \<< "8 -8 12 -12 19 -19 21 -21 1 8" STR\-> START chk EVAL NEXT \>> \<< "9 -9 11 -11 1 4" mmv EVAL \>> \<< "1 -1 10 -10 1 4" mmv EVAL \>> \<< "1 -1 9 -9 10 -10 11 -11 1 8" mmv EVAL \>> \<< "1 -1 9 -9 10 -10 11 -11 1 8" STR\-> START chk EVAL NEXT IF p 25 SAME p 95 SAME OR THEN IF p 1 + BDGT NOT p 2 + BDGT NOT AND p 3 + BDGT ABS 4 SAME AND THEN p 2 + p 3 + p 1 + R\->C admov EVAL END IF p 1 - BDGT NOT p 2 - BDGT NOT AND p 3 - BDGT NOT AND p 4 - BDGT ABS 4 SAME AND THEN p 2 - p 4 - p 1 - R\->C admov EVAL END END \>> } pce GET EVAL \>> \>> \>> xt sq \>> \>> SHOWMV \<< C\->R UNCVT SWAP UNCVT SWAP + 4 DIS DROP \>> UNCVT \<< 10 / DUP IP 1 - \->STR SWAP FP 10 * "abcdefgh" SWAP DUP SUB SWAP + \>> COORDS \<< 10 / DUP IP 1 - SWAP FP 10 * R\->C \>> RD2 \<< 100 * IP 100 / \>> BDGT \<< 'BRD' SWAP GET \>> DRWB \<< 21 \-> n \<< (1,1) WHILE 99 n \>= REPEAT n IF 5 FS? THEN 119 SWAP - END BDGT DUP ABS SWAP SIGN \-> p col \<< IF p 7 \=/ THEN DUP PICT SWAP # 8h # 8h BLANK IF n DUP 10 / IP + 2 MOD THEN NEG END REPL END IF p 0 \=/ THEN IF p 7 SAME THEN (-40,4) + ELSE DUP IF n DUP 10 / IP + 2 MOD DUP col -1 SAME XOR THEN 2 ELSE 1 END FIG SWAP GET p GET PICT 4 ROLLD SWAP \<< GXOR \>> \<< GOR \>> IFTE END END \>> (8,0) + n 1 + 'n' STO END DROP \>> \>> MOVE \<< 6 CF " " 3 DIS " " 4 DIS IF INP "quit" == THEN 1 SF ELSE IF INP "halt" == THEN HALT ELSE IF INP "swap" == THEN IF 5 DUP FS? THEN CF ELSE SF END 6 SF 119 PKNG - 119 CKNG - 'PKNG' STO 'CKNG' STO DRWB ELSE PLMV END IF 6 FS? THEN CPMV ELSE "Illegal move" 6 DIS ERRBELL END END END \>> DIS \<< 1 - 10 * SWAP 2 \->GROB SWAP 57 SWAP - -66 SWAP R\->C SWAP PICT 3 ROLLD REPL \>> input \<< WHILE key REPEAT \-> st \<< IF st SIZE 1 SAME THEN INP 2 4 SUB st + 'INP' STO ELSE IF st "ENTER" SAME THEN 2 CF ELSE IF st "DEL" SAME THEN "____" 'INP' STO ELSE IF st "BACK" SAME THEN "_" INP 1 3 SUB + 'INP' STO END END END END INP 2 DIS \>> END \>> FINP \<< 2 SF "Your move?" 1 DIS INP 2 DIS WHILE 2 FS? REPEAT input END " " 1 DIS \>> ERRBELL \<< 440 .1 BEEP \>> STBRD "[7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 4 2 3 5 6 3 2 4 7 7 1 1 1 1 1 1 1 1 7 7 0 0 0 0 0 0 0 0 7 7 0 0 0 0 0 0 0 0 7 7 0 0 0 0 0 0 0 0 7 7 0 0 0 0 0 0 0 0 7 7 -1 -1 -1 -1 -1 -1 -1 -1 7 7 -4 -2 -3 -5 -6 -3 -2 -4 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7" key \<< { { "a" "b" "c" "d" "e" "f" } { "g" "h" "i" "j" "k" "l" } { "m" "n" "o" "p" "q" "r" } { "s" "t" "u" "v" "w" "x" } { "ENTER" "y" "z" "DEL" "BACK" } { "" "7" "8" "9" "" } { "" "4" "5" "6" "" } { "" "1" "2" "3" "-" } { "" "0" "." " " "+" } } KEY \<< 10 / DUP IP SWAP FP 10 * 3 ROLLD GET SWAP GET IF DUP SIZE THEN 1 ELSE DROP 0 END \>> \<< DROP 0 \>> IFTE \>> PPAR { (-66,-6) (64,57) constant 1 (0,0) FUNCTION Y } END